home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 136 / 136.d81 / grafstar demo (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  8KB  |  279 lines
  1. 0 rem    grafstar.demo   by dave moorman
  2. 1 rem  make room for tools 9a00
  3. 2 poke55,0:poke56,154:clr
  4. 3 rem  <required for ls> set device
  5. 5 dv=peek(186):ifdv<8thendv=8
  6. 9 rem  hi is for grafstar c000.                poke disables irq before load
  7. 10 hi=192:pokehi*256+63,0
  8. 19 rem  memorize this bload routine!
  9. 20 sys57812"grafstar c000",dv,0:poke780,0:poke781,0:poke782,hi:sys65493
  10. 22 rem  grafstar sysies as names
  11. 23 op=hi*256 :rem    open
  12. 24 mode=op+3 :rem    mode
  13. 25 plot=op+6 :rem    plot
  14. 26 line=op+9 :rem    line
  15. 27 poin=op+12:rem    point
  16. 28 clip=op+15:rem    clip
  17. 29 ofst=op+18:rem    offset
  18. 30 yrev=op+21:rem    y-reverse
  19. 31 flip=op+24:rem    irq flipper
  20. 32 fill=op+27:rem    fill
  21. 33 penc=op+30:rem    pencolor
  22. 34 :
  23. 49 rem  bload tools 9a00
  24. 50 sys57812"tools 9a00",dv,0:poke780,0
  25. 51 poke781,0:poke782,154:sys65493
  26. 52 rem   tools 9a00 sysies as names
  27. 53 mu=154*256   :rem    menu
  28. 54 box=mu+3     :rem    box
  29. 55 shade=mu+39  :rem    shade
  30. 56 ss=mu+6      :rem    screen stash
  31. 57 sr=mu+9      :rem    screen restore
  32. 58 pa=mu+15     :rem    print at
  33. 59 ct=mu+18     :rem    print center
  34. 60 branch=mu+45 :rem    branch
  35. 61 :
  36. 98 ::::::::::::::::::::::::::::::::::
  37. 99 rem  demo screen and menu
  38. 100 print"[147]":poke53281,0:poke53280,0:poke53272,22:poke53265,11
  39. 110 sysbox,0,39,0,24,102,15
  40. 119 rem  windoze routine at 20000.              x=-1 means center box
  41. 120 x=-1:y=2:m=2:c=7:m$(1)="[215]elcome to"
  42. 130 m$(2)="[199] [210] [193] [198] [211] [212] [193] [210]   [196] [197] [205] [207]"
  43. 140 gosub20000
  44. 148 :
  45. 149 rem windoze routine at 20000.               x is real column
  46. 150 x=3:y=8:m=4:c=1
  47. 151 m$(1)="[213]se the menu to choose various
  48. 152 m$(2)[178]"effects.  (NULL)ist the program
  49. 153 m$(3)="for detailed remarks.  [200]ave
  50. 154 m$(4)[178]"asc(NULL)(NULL) with chr$raf(NULL)tar!  str$ (NULL)oorman
  51. 155 gosub20000
  52. 159 rem  windoze routine at 20000
  53. 160 x=12:y=16:m=6:c=14
  54. 161 m$(1)="[195]razy [195]ircles"
  55. 162 m$(2)="[205]oire [208]atterns"
  56. 163 m$(3)="[198]ast [198]ill"
  57. 164 m$(4)="[208]olygon [206]uts"
  58. 165 m$(5)="[204]ist [208]rogram"
  59. 166 m$(6)="[197]xit [199]raf[211]tar"
  60. 167 gosub20000:poke53265,27
  61. 169 rem  menu
  62. 170 sysmu,y+1,xx+2,xx+wd-1,6,14,1,0
  63. 180 onf%gosub1000,2000,3000,4000,5000,61000
  64. 190 goto100
  65. 998 :::::::::::::::::::::::::::::::::
  66. 999 rem      crazy circles
  67. 1000 sys op,224,204 :rem <must> set maps
  68. 1009 rem  switch on high-res with clear
  69. 1010 sys mode,5
  70. 1014 rem set clip to whole screen
  71. 1015 sys clip, 0, 320, 0, 200
  72. 1019 rem for 10 times:
  73. 1020 fory=1to10
  74. 1029 rem find random centers for circle
  75. 1030 cx=rnd(1)*320
  76. 1040 cy=rnd(1)*200
  77. 1049 rem find random x / y radii
  78. 1050 x1=rnd(1)*160
  79. 1060 y1=rnd(1)*100
  80. 1064 rem choose random color
  81. 1065 c=rnd(1)*15+1
  82. 1069 rem set offset to center circle
  83. 1070 sys ofst, cx, cy
  84. 1079 rem plot first point on circle
  85. 1080 sys plot, sin(0)*x1, cos(0)*y1, 1
  86. 1085 sys penc,0,c,0,0
  87. 1089 rem then draw lines around circle
  88. 1090 forx=.3 to (NULL)*2+.3 step .3
  89. 1100 sys line, sin(x)*x1, cos(x)*y1, 1
  90. 1110 next: next
  91. 1114 rem return offset to normal
  92. 1115 sys ofst, 0, 0
  93. 1116 sys fill, 160, 100, 1
  94. 1119 rem routine finished
  95. 1120 poke53280,12
  96. 1129 rem wait for keystroke
  97. 1130 poke198,0:wait198,1:poke198,0
  98. 1139 rem and go back to menu
  99. 1140 print"[147]":sys mode, 0
  100. 1150 return
  101. 1998 :::::::::::::::::::::::::::::::
  102. 1999 rem  moire pattern                      set bitmap/colormap location
  103. 2000 sys op, 224, 204
  104. 2009 rem switch to multi-color. clear
  105. 2010 sys mode, 7
  106. 2019 rem set up window clip limits
  107. 2020 x1=40:x2=110:y1=25:y2=125
  108. 2029 rem  set center for moray
  109. 2030 cx=90:cy=60
  110. 2039 rem draw object
  111. 2040 sys clip, x1, x2, y1, y2
  112. 2049 rem  set offset to center of moire
  113. 2050 sys ofst, cx, cy
  114. 2059 rem  choose pen colors
  115. 2060 sys penc, 0, 1, 7, 3
  116. 2064 rem and choose pen number
  117. 2065 p=0
  118. 2069 rem for 10 times
  119. 2070 fory=1to10
  120. 2074 rem increase and rollover pen #
  121. 2075 p=(p+1)and3
  122. 2079 rem going around the circle
  123. 2080 forx=0 to (NULL)*2 step .1
  124. 2089 rem plot the center
  125. 2090 sys plot, 0, 0, p
  126. 2099 rem and line to circumference
  127. 2100 sys line, sin(x)*100, cos(x)*100,p
  128. 2110 next
  129. 2119 rem move window and moire center
  130. 2120 x1=x1+3:x2=x2+3:y1=y1+2:y2=y2+2
  131. 2130 cx=cx-3: cy=cy+2
  132. 2139 rem change moire center
  133. 2140 sys ofst, cx, cy
  134. 2149 rem change window location
  135. 2150 sys clip, x1, x2, y1, y2
  136. 2160 next
  137. 2169 rem routine over
  138. 2170 poke53280,12
  139. 2180 poke198,0:wait198,1:poke198,0
  140. 2190 print"[147]":sys mode, 0
  141. 2200 return
  142. 2998 :::::::::::::::::::::::::::::::
  143. 2999 rem   fast fill routine                       set bitmap/colormap memory
  144. 3000 sys op, 224, 204
  145. 3009 rem switch to multi-color/ clear
  146. 3010 sys mode, 7
  147. 3019 rem set offset to normal
  148. 3020 sys ofst, 0, 0
  149. 3024 rem set pen colors
  150. 3025 sys penc, 0, 1, 2, 3
  151. 3029 rem set cliping to whole screen
  152. 3030 sys cl, 0, 160, 0, 200
  153. 3039 rem draw object
  154. 3040 :sys plot, 0, 0, 1
  155. 3050 :sys line, 159, 0, 1
  156. 3060 :sys line, 159, 199, 1
  157. 3070 :sys line, 0, 199, 1
  158. 3080 :sys line, 0, 0, 1
  159. 3090 :sys plot, 10, 10, 2
  160. 3100 :forx=10 to 140 step 20
  161. 3110 :sys line, x, 40, 2
  162. 3120 :sys line, x+10, 40, 2
  163. 3130 :sys line, x+10, 10, 2
  164. 3140 :sys line, x+20, 10, 2
  165. 3150 :next
  166. 3160 :sys line, x, 100, 2
  167. 3170 :sys line, 70, 150, 2
  168. 3180 :sys line, 50, 50, 2
  169. 3190 :sys line, 70, 45, 2
  170. 3200 :sys line, 50, 45, 2
  171. 3210 :sys line, 70, 50, 2
  172. 3220 :sys line, 40,90, 2
  173. 3230 :sys line, 10, 100, 2
  174. 3240 :sys line, 5, 10, 2
  175. 3250 :sys line, 10, 10, 2
  176. 3260 :sys fill, 100, 80, 3
  177. 3270 sys penc, 0, 7, 2, 3
  178. 3279 rem   fill middle area
  179. 3280 sys fill, 55, 55, 1
  180. 3289 rem   draw circle
  181. 3290 sys ofst, 30, 160
  182. 3300 sys plot, sin(0)*15, cos(0)*10, 3
  183. 3310 forx=.3 to (NULL)*2+.3step.3
  184. 3320 sys line, sin(x)*15, cos(x)*10, 3
  185. 3330 next
  186. 3339 rem   fill circle
  187. 3340 sys penc, 0, 7, 5, 5
  188. 3350 sys ofst, 0, 0
  189. 3360 sys fill, 30, 160, 2
  190. 3370 sys penc, 6, 7, 5, 3
  191. 3379 rem   fill outer area                 (i had to do some hedging here)
  192. 3380 forx=15to155step20:sys fill, x, 39, 1:next:sys fill, 1, 1, 1
  193. 3389 rem fill inner area with pen 0
  194. 3390 sys fill, 100, 80, 0
  195. 3399 rem end routine.                            flash until keypress
  196. 3400 poke53281,rnd(1)*16:getz$:ifz$=""then3400
  197. 3410 print"[147]":sys mode, 0
  198. 3420 return
  199. 3998 :::::::::::::::::::::::::::::::
  200. 3999 rem  polygon nuts
  201. 4000 sys op, 224, 204
  202. 4004 rem  flip lets you press shift/control/f1 to flip between screens
  203. 4005 sys flip,1
  204. 4009 rem switch to multi-color/ clear
  205. 4010 sys mode, 7
  206. 4019 rem set pen colors
  207. 4020 sys penc, 0, 1, 7, 10
  208. 4029 rem define edges of area                    and draw a box around it
  209. 4030 le=50:ri=110:tp=50:bt=150
  210. 4031 sys plot,49,49,1:sysline,111,49,1:sysline,111,151,1
  211. 4032 sysline,49,151,1:sysline,49,49,1
  212. 4033 rem  define deltas for each vertex
  213. 4034 dx(0)=-2:dy(0)=1
  214. 4035 dx(1)=1:dy(1)=-2
  215. 4036 dx(2)=-1:dy(2)=-1
  216. 4037 dx(3)=2:dy(3)=2
  217. 4039 rem set vertices at 100
  218. 4040 forx=0to3
  219. 4050 px(x,0)=100
  220. 4060 py(x,0)=100
  221. 4065 next
  222. 4099 rem sq is lag time.  q is current plot.  oq is last plot.  rq is erased
  223. 4100 sq=7:oq=q:q=(q+1)andsq:rq=(q-sq)andsq:forx=0to3
  224. 4109 rem  calculate new coordinates
  225. 4110 px(x,q)=px(x,oq)+dx(x)
  226. 4120 py(x,q)=py(x,oq)+dy(x)
  227. 4129 rem check if in area
  228. 4130 if(px(x,q)<le)thendx(x)=-dx(x):px(x,q)=le:goto4200
  229. 4135 ifpx(x,q)>rithendx(x)=-dx(x):px(x,q)=ri:goto4200
  230. 4140 ifpy(x,q)<tpthendy(x)=-dy(x):py(x,q)=tp:goto4200
  231. 4145 ifpy(x,q)>btthendy(x)=-dy(x):py(x,q)=bt:goto4200
  232. 4200 next
  233. 4209 rem plot and line vertices
  234. 4210 sys plot,px(0,q),py(0,q)  ,1
  235. 4220 sys line,px(1,q),py(1,q)  ,2
  236. 4230 sys line,px(2,q),py(2,q)  ,3
  237. 4240 sys line,px(3,q),py(3,q)  ,2
  238. 4250 sys line,px(0,q),py(0,q)  ,1
  239. 4260 sys plot,px(0,rq),py(0,rq),0
  240. 4270 sys line,px(1,rq),py(1,rq),0
  241. 4280 sys line,px(2,rq),py(2,rq),0
  242. 4290 sys line,px(3,rq),py(3,rq),0
  243. 4300 sys line,px(0,rq),py(0,rq),0
  244. 4309 rem if key not pressed, do again
  245. 4310 getz$:ifz$=""then4100
  246. 4320 print"[147]":sys mode, 0:sysflip,0
  247. 4330 return
  248. 4998 :::::::::::::::::::::::::::::::::
  249. 4999 rem     list program
  250. 5000 print"[147]":list
  251. 19998 :::::::::::::::::::::::::::::::::
  252. 19999 end:rem  20000- window drawer
  253. 20000 wd=0:fori=1tom:ifwd<len(m$(i))thenwd=len(m$(i))
  254. 20010 next:wd=wd+2:ifint(wd/2)<>wd/2thenwd=wd+1
  255. 20015 xx=x
  256. 20020 ifx<0thenxx=int(20-wd/2)
  257. 20030 sysshade,xx+1,xx+wd+1,y+1,y+m+1+1
  258. 20040 sysbox,xx,xx+wd,y,y+m+1,160,c
  259. 20050 poke646,c:print"";:fori=1tom
  260. 20060 ifx<0thensysct,y+i,m$(i):goto20070
  261. 20065 syspa,xx+2,y+i,m$(i)